home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / DEMO / PROGDEFD.M < prev    next >
Encoding:
Text File  |  1991-04-17  |  8.2 KB  |  223 lines
  1. MODULE ProgDefDemo;
  2.  
  3. (* /////////////////////////////////////////////////////////////////////////
  4.  *
  5.  * Dies ist ein Demo-Programm für die Anwendung von benutzerdefinierten
  6.  * Objekten.
  7.  *
  8.  * Das Programm benötigt die Resource-Datei "PROGDEF.RSC"; ggf. ist sie
  9.  * in den Ordner, in dem auch der Programmcode steht (USER\MOD\), zu kopieren.
  10.  *
  11.  * Das Programm stammt von Harry Böck, überarbeitet von Thomas Tempelmann.
  12.  *
  13.  * ////////////////////////////////////////////////////////////////////// *)
  14.  
  15. FROM GEMEnv          IMPORT InitGem, GemActive, ExitGem, GemError,
  16.                             CurrGemHandle, RC, GemHandle, DeviceHandle;
  17. FROM AESResources    IMPORT ResourcePart, ResourceAddr, LoadResource,
  18.                             FreeResource;
  19. FROM AESObjects      IMPORT DrawObject;
  20. FROM AESForms        IMPORT FormDo, FormCenter, FormDial, FormDialMode,
  21.                             FormAlert;
  22. FROM AESWindows      IMPORT UpdateWindow;
  23. FROM EasyGEM0        IMPORT ShowMouse, HideMouse, ShowArrow, ShowBee;
  24. FROM ObjHandler      IMPORT SetCurrObjTree,
  25.                             SetObjType, ProgDefCarrier, MakeProgDefProc,
  26.                             CreateSpecification, SetProgDefSpec;
  27. FROM GEMGlobals      IMPORT MaxStr, PtrMaxStr, ObjSpec, ObjType, ObjFlag,
  28.                             ObjState, OStateSet, OFlagSet, PtrObjSpec,
  29.                             ApplBlock, ParmBlock, PtrObjTree,
  30.                             TextEffect, TEffectSet, TVertJust, THorJust;
  31. FROM GrafBase        IMPORT Rectangle, Point, Rect, Pnt, WritingMode,
  32.                             ClipRect, MinPoint;
  33.  
  34. FROM VDIAttributes   IMPORT SetWritingMode, SetTextEffects,
  35.                             SetAbsTHeight, SetTAlignment;
  36. FROM VDIControls     IMPORT SetClipping, DisableClipping;
  37. FROM VDIOutputs      IMPORT GrafText;
  38.  
  39. FROM SYSTEM          IMPORT ADR, LONGWORD;
  40. FROM Storage         IMPORT ALLOCATE;
  41. FROM MOSGlobals      IMPORT MemArea, MEM, fInsufficientMemory;
  42. FROM PrgCtrl         IMPORT TermProcess;
  43.  
  44.  
  45. (* Diese Konstanten stammen aus dem vom RCP erzeugten D-File: *)
  46.  
  47. CONST
  48.   Form1    =   0;  (* Formular/Dialog *)
  49.   Frame    =   0;  (* BOX in Baum FORM1 *)
  50.   Head1    =   1;  (* STRING in Baum FORM1 *)
  51.   Head2    =   2;  (* STRING in Baum FORM1 *)
  52.   Head3    =   3;  (* STRING in Baum FORM1 *)
  53.   Button2u =   4;  (* BUTTON in Baum FORM1 *)
  54.  
  55.  
  56. CONST
  57.   noRCS = "[3][ RSC-File ist nicht da! ][ ENDE ]";
  58.  
  59.  
  60. TYPE   StringRec = POINTER TO RECORD
  61.                                 str      : PtrMaxStr;
  62.                                 effect   : TEffectSet;
  63.                                 fontSize : CARDINAL;
  64.                                 carrier  : ApplBlock;
  65.                               END;
  66.  
  67. VAR     GemHdl             : GemHandle;
  68.         DevHdl             : DeviceHandle;
  69.         ResourceFileLoaded : BOOLEAN;
  70.  
  71.  
  72. PROCEDURE StartApplication (REF RscFile: ARRAY OF CHAR): BOOLEAN;
  73.  
  74.   VAR  i, res: CARDINAL;
  75.        ok    : BOOLEAN;
  76.  
  77.   BEGIN
  78.     ResourceFileLoaded:= FALSE;
  79.     InitGem (RC, DevHdl, ok);
  80.     IF NOT ok THEN
  81.       TermProcess (fInsufficientMemory)
  82.     END;
  83.     GemHdl:= CurrGemHandle ();
  84.     UpdateWindow (TRUE);
  85.     ShowBee ();
  86.     IF LENGTH (RscFile) # 0 THEN       (* soll ResourceFile gelesen werden? *)
  87.       LoadResource (RscFile);                          (* lade ResourceFile *)
  88.       IF GemError () THEN
  89.         ok:= FALSE;
  90.         FormAlert (1, noRCS, res);                (* melde "Datei nicht da" *)
  91.       ELSE
  92.         ResourceFileLoaded:= TRUE;
  93.       END;
  94.     END;
  95.     ShowArrow ();
  96.     UpdateWindow (FALSE);
  97.     RETURN ok
  98.   END StartApplication;
  99.  
  100. PROCEDURE CloseApplication ();
  101.   BEGIN
  102.     IF ResourceFileLoaded THEN                    (* wenn Resource geladen, *)
  103.       FreeResource ();                            (* gib sie wieder frei    *)
  104.     END;
  105.     ExitGem (GemHdl);                                           (* GEM ade! *)
  106.   END CloseApplication;
  107.  
  108.  
  109. (*
  110.  * Die folgende Prozedur ist die benutzerdefinierte Funktion für
  111.  * das Zeichnen von Strings mit Attributen.
  112.  * Dazu wird unten diese Prozedur mittels "MakeProgDefProc" als
  113.  * Objekt-Zeichenfunktion vorbereitet und dann mit "SetProgDefSpec"
  114.  * auf die gewünschten Objekte angemeldet.
  115.  * Die Attribute werden beim Anmelden in einem extra angelegten Record
  116.  * (StringRec) festgelegt und ein Zeiger darauf hier in 'param' übergeben.
  117.  *)
  118.  
  119. PROCEDURE DrawText  (tree  : PtrObjTree;        (* Baum *)
  120.                      index : CARDINAL;          (* Objektnr. *)
  121.                      prevS,
  122.                      currS : OStateSet;
  123.                      space,
  124.                      clip  : Rectangle;
  125.                      param : LONGWORD): OStateSet;
  126.  
  127.   VAR   obj: StringRec;
  128.         d  : CARDINAL;
  129.         p  : Point;
  130.  
  131.   BEGIN
  132.     (* Vorsicht: Hier dürfen VDI, aber keine AES-Routinen gerufen werden! *)
  133.     
  134.     obj:= StringRec (param);                             (* ObjektDaten holen *)
  135.     
  136.     SetTextEffects (DevHdl, obj^.effect);                 (* Parameter setzen *)
  137.     IF (obj^.fontSize # 0) THEN
  138.       SetAbsTHeight (DevHdl, obj^.fontSize, d, d, d, d);
  139.     END;
  140.     SetWritingMode (DevHdl, replaceWrt);
  141.     
  142.     p:= MinPoint (space);                         (* StringPosition berechnen *)
  143.     p.y:= p.y + space.h - 2;
  144.     
  145.     SetClipping (DevHdl, clip);                            (* String ausgeben *)
  146.     GrafText (DevHdl, p, obj^.str^);
  147.     DisableClipping (DevHdl);
  148.     
  149.     RETURN OStateSet {}
  150.   END DrawText;
  151.  
  152.  
  153. VAR
  154.         procHandle         : ProgDefCarrier;
  155.         procStack          : ARRAY [1..500] OF CARDINAL; (* 1 KB reicht *)
  156.  
  157.         strObj1,
  158.         strObj2            : StringRec;
  159.  
  160.         Baum               : PtrObjTree;
  161.         exit               : CARDINAL;
  162.         dialSpace          : Rectangle;
  163.  
  164. BEGIN
  165.   IF StartApplication ('PROGDEF.RSC') THEN
  166.  
  167.     Baum:= ResourceAddr (treeRsrc, Form1);
  168.     SetCurrObjTree (Baum, FALSE);
  169.     dialSpace:= FormCenter (Baum);
  170.     FormDial (reserveForm, dialSpace, dialSpace); (* Platz f. Box reservieren *)
  171.  
  172.     (* Prozedur 'DrawText' für benutzerdef. Objekt vorbereiten *)
  173.     MakeProgDefProc (procHandle, DrawText, MEM (procStack));
  174.  
  175.     (*
  176.      * Parameter für 'DrawText' vorbereiten.
  177.      * Wir haben vor, die ersten beiden der drei vorhandenen String-Objekte
  178.      * (Head1 und Head2) in der Box als benutzerdef. Objekte mittels
  179.      * 'DrawText' zeichnen zu lassen.
  180.      * Das erste Objekt soll fett und unterstrichen, das zweite nur unter-
  181.      * strichen gezeichnet werden. Das dritte Objekt bleibt weiterhin
  182.      * ein normales Text-Objekt und kann vom GEM nur ohne bestimmte
  183.      * Attribute gezeichnet werden.
  184.      *)
  185.     NEW (strObj1);                        (* Parameter f. 1. Objekt anlegen *)
  186.     (* Wir merken uns den Zeiger auf den Text des String-Objekts, da
  187.      * 'spec.more' bei Aufruf von 'SetProgDefSpec' auf die benutzerdef.
  188.      * Funktion umgesetzt wird: *)
  189.     strObj1^.str:= PtrMaxStr (Baum^[Head1].spec.more);
  190.     strObj1^.effect:= TEffectSet {thickText, underlineText};
  191.     strObj1^.fontSize:= 0;
  192.     (* Objekt-Typ umdefinieren: *)
  193.     SetObjType (Head1, progDefObj);
  194.     (* Speicher zuweisen, in dem das Handle der benutzerdef. Proz. sowie der
  195.      * Parameter 'strObj1' gesichert werden kann: *)
  196.     CreateSpecification (Head1, ADR (strObj1^.carrier));
  197.     (* und nun die benutzerdef. Proz. und den Zeiger auf die Parms setzen: *)
  198.     SetProgDefSpec (Head1, procHandle, strObj1);
  199.  
  200.     NEW (strObj2);                        (* Parameter f. 2. Objekt anlegen *)
  201.     strObj2^.str:= PtrMaxStr (Baum^[Head2].spec.more);
  202.     strObj2^.effect:= TEffectSet {underlineText};
  203.     strObj2^.fontSize:= 0;
  204.     SetObjType (Head2, progDefObj);
  205.     CreateSpecification (Head2, NIL(*ADR (strObj2^.carrier)*));
  206.     SetProgDefSpec (Head2, procHandle, strObj2);
  207.  
  208.     UpdateWindow (TRUE);
  209.     HideMouse;
  210.     DrawObject (Baum, 0, 8, dialSpace);                  (* zeichne die Box *)
  211.     ShowMouse;
  212.     UpdateWindow (FALSE);
  213.     LOOP
  214.       FormDo (Baum, 0, exit);                               (* führe Dialog *)
  215.       IF (exit = Button2u) THEN EXIT END;
  216.     END;
  217.     
  218.     FormDial (freeForm, dialSpace, dialSpace);    (* Platz f. Box freigeben *)
  219.     
  220.     CloseApplication;
  221.   END; (* IF *)
  222. END ProgDefDemo.
  223.